home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / system / usniff.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-09-09  |  3.3 KB  |  133 lines
  1. unit Usniff;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Clipbrd;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     OpenDialog: TOpenDialog;
  12.     Button1: TButton;
  13.     CurrentFile: TLabel;
  14.     Bevel1: TBevel;
  15.     FileList: TListBox;
  16.     Label1: TLabel;
  17.     Button2: TButton;
  18.     Label2: TLabel;
  19.     Label3: TLabel;
  20.     procedure Button1Click(Sender: TObject);
  21.     procedure Button2Click(Sender: TObject);
  22.   private
  23.     { Private declarations }
  24.   public
  25.     { Public declarations }
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.  
  31. implementation
  32.  
  33. {$R *.DFM}
  34.  
  35. uses DLLPeek;
  36.  
  37. function FormatPathToFit (const fName: String; Canvas: TCanvas; AvailWidth: Integer): String;
  38. var
  39.     Idx: Integer;
  40.     Drive: String[4];
  41.     Path, Name, Ext: String;
  42.  
  43.     procedure ShortenPath;
  44.     var
  45.         StartSlash: Boolean;
  46.     begin
  47.         if Path = '\' then Path := '' else begin
  48.             if Path[1] = '\' then begin
  49.                 StartSlash := True;
  50.                 Path := Copy (Path, 2, 255);
  51.             end
  52.             else StartSlash := False;
  53.  
  54.             if Path[1] = '.' then Path := Copy (Path, 5, 255);
  55.  
  56.             Idx := Pos ('\', Path);
  57.             if Idx <> 0 then Path := '...\' + Copy (Path, Idx + 1, 255)
  58.             else Path := '';
  59.  
  60.             if StartSlash then Path := '\' + Path;
  61.         end;
  62.     end;
  63.  
  64. begin
  65.     Result := fName;
  66.     Path := ExtractFilePath (Result);
  67.     Name := ExtractFileName (Result);
  68.     Idx := Pos ('.', Name);
  69.     if Idx > 0 then Name[0] := Chr (Idx - 1);
  70.     Ext := ExtractFileExt (Result);
  71.     if Path [2] = ':' then begin
  72.         Drive := Copy (Path, 1, 2);
  73.         Path := Copy (Path, 3, 255);
  74.     end
  75.     else Drive := '';
  76.  
  77.     while ((Path <> '') or (Drive <> '')) and (Canvas.TextWidth (Result) > AvailWidth) do
  78.     begin
  79.         if Path = '\...\' then begin
  80.             Drive := '';
  81.             Path := '...\';
  82.         end
  83.         else if Path = '' then Drive := ''
  84.         else ShortenPath;
  85.  
  86.         Result := Drive + Path + Name + Ext;
  87.     end;
  88. end;
  89.  
  90. procedure TForm1.Button1Click (Sender: TObject);
  91. var
  92.     TheList: TStringList;
  93. begin
  94.     if OpenDialog.Execute then begin
  95.         CurrentFile.Caption := FormatPathToFit (OpenDialog.FileName, Canvas, CurrentFile.Width);
  96.         TheList := TStringList.Create;
  97.         TheList.Sorted := True;
  98.         GetDLLList (OpenDialog.FileName, TheList);
  99.         FileList.Items.Assign (TheList);
  100.         TheList.Free;
  101.     end;
  102. end;
  103.  
  104. procedure TForm1.Button2Click(Sender: TObject);
  105. var
  106.     RenderBuffer: PChar;
  107.     Idx, ByteCount: Integer;
  108.     Buff: array [0..255] of Char;
  109. begin
  110.     ByteCount := 0;
  111.     for Idx := 0 to FileList.Items.Count - 1 do
  112.         Inc (ByteCount, Length (FileList.Items [Idx]) + 2);
  113.     Inc (ByteCount);
  114.  
  115.     { Allocate a buffer for rendering the DLL list }
  116.     GetMem (RenderBuffer, ByteCount);
  117.     try
  118.         RenderBuffer [0] := #0;
  119.         for Idx := 0 to FileList.Items.Count - 1 do
  120.             lstrcat (RenderBuffer, StrPCopy (Buff, FileList.Items [Idx] + #13 + #10));
  121.         Clipboard.SetTextBuf (RenderBuffer);
  122.         MessageDlg ('DLL list has been copied to the Windows clipboard.',
  123.                     mtInformation, [mbOK], 0);
  124.     finally
  125.         FreeMem (RenderBuffer, ByteCount);
  126.     end;
  127. end;
  128.  
  129. end.
  130.  
  131.  
  132.  
  133.